home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1993 April
/
CICA MS Windows - April 1993.iso
/
unzipped
/
programr
/
tp
/
printbmp
/
hcopy.bak
next >
Wrap
Text File
|
1991-10-28
|
2KB
|
67 lines
{************************************************}
{ }
{ Turbo Pascal for Windows }
{ Tips & Techniques Demo Program }
{ Copyright (c) 1991 by Borland International }
{ }
{************************************************}
unit HCopy;
interface
uses WinTypes;
procedure PrintBitMap(HWindow: HWnd; BitMap: HBitMap);
implementation
uses WinProcs, Strings;
procedure PrintBitMap(HWindow: HWnd; BitMap: HBitMap);
var
DC, ScreenDC, MemDC: HDC;
BM: TBitMap;
OldBitMap: HBitMap;
Driver, PrintDevice, Port: array[0..40] of Char;
S: array[0..10] of Char;
DCaps: Word;
procedure GetIniInfo(ADriver, ADevice, Port: PChar);
var
PrinterString: array[0..80] of char;
Device, Driver, OutPut: PChar;
begin
GetProfileString('Windows', 'Device', ',,,', PrinterString, 80);
Device := PrinterString;
Driver := StrScan(Device, ',');
Driver[0] := #0;
Inc(Driver);
OutPut := StrScan(Driver, ',');
OutPut[0] := #0;
Inc(OutPut);
StrCopy(Port, OutPut);
StrCopy(ADevice, Device);
StrCopy(ADriver, Driver);
end;
begin
GetIniInfo(Driver, PrintDevice, Port);
DC := CreateDC(Driver, PrintDevice, Port, Nil);
StrCopy(S,'HardCopy'#0);
Escape(DC, STARTDOC, 8, @S, nil);
ScreenDC := GetDC(HWindow);
MemDC := CreateCompatibleDC(ScreenDC);
OldBitMap := SelectObject(MemDC, BitMap);
GetObject(BitMap, SizeOf(BM), @BM);
BitBlt(DC, 0, 0, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCOPY);
BitBlt(DC, 0, 0, BM.bmWidth, BM.bmHeight, MemDC, 0, 0, SRCCOPY);
Escape(DC, NEWFRAME, 0, nil, nil);
Escape(DC, ENDDOC, 0, nil, nil);
SelectObject(MemDC, OldBitMap);
ReleaseDC(HWindow, ScreenDC);
DeleteDC(MemDC);
DeleteDC(DC);
end;
END.